#!/usr/bin/perl

# Xumerle Luciano <luciano.xumerle@medgen.univr.it>
#
# Copyright (c) 2012 Xumerle Luciano. All rights reserved.
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License version 2
# as published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; see the file COPYING.  If not, write to the Free
# Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
# 02111-1307, USA.
#

use strict;
use warnings;

my $VERSION   = '0.1';
my $COPYRIGHT = '2012';
my $DATE      = '20 feb 2012';

=head1 FIELDS IN DEFUSE RESULTS

0: cluster_id
1: splitr_sequence
2: splitr_count
3: splitr_span_pvalue
4: splitr_pos_pvalue
5: splitr_min_pvalue
6: adjacent
7: altsplice
8: break_adj_entropy1
9: break_adj_entropy2
10: break_adj_entropy_min
11: break_predict
12: breakpoint_homology
13: breakseqs_estislands_percident
14: cdna_breakseqs_percidqent
15: concordant_ratio
16: deletion -------------------------
17: est_breakseqs_percident
18: eversion -------------------------
19: exonboundaries
20: expression1
21: expression2
22: gene1 -------------------------
23: gene2 -------------------------
24: gene_align_strand1
25: gene_align_strand2
26: gene_chromosome1 -------------------------
27: gene_chromosome2 -------------------------
28: gene_end1
29: gene_end2
30: gene_location1
31: gene_location2
32: gene_name1 -------------------------
33: gene_name2 -------------------------
34: gene_start1
35: gene_start2
36: gene_strand1
37: gene_strand2
38: genome_breakseqs_percident
39: genomic_break_pos1
40: genomic_break_pos2
41: genomic_strand1 -------------------------
42: genomic_strand2 -------------------------
43: interchromosomal -------------------------
44: interrupted_index1
45: interrupted_index2
46: inversion -------------------------
47: library_name
48: max_map_count
49: max_repeat_proportion
50: mean_map_count
51: min_map_count
52: num_multi_map
53: num_splice_variants
54: orf
55: read_through
56: repeat_proportion1
57: repeat_proportion2
58: span_count
59: span_coverage1
60: span_coverage2
61: span_coverage_max
62: span_coverage_min
63: splice_score
64: splicing_index1
65: splicing_index2
66: probability

=cut

#
# PARSE PARAMETERS TO MERGE FILE
#
my @defusefilteredlist = ();
if ( defined $ARGV[0] && $ARGV[0] eq '-merge' )
{
    foreach my $f ( @ARGV[ 1 .. $#ARGV ] )
    {
        push @defusefilteredlist, $f;
    }

    &merge_defuse_results( \@defusefilteredlist );
}
elsif ( defined $ARGV[1] && $ARGV[0] eq '-parse' && -f $ARGV[1] )
{
    &parse_merged( $ARGV[1] );
}
else
{
    my $n = $0;
    $n =~ s/.pl$//;
    $n =~ s/^.+\///;
    print STDERR qq|$n version $VERSION - $DATE
Copyright (C) $COPYRIGHT Luciano Xumerle
|;
    print qq|
SYNTAX PHASE1:
 > $n -merge <defuse.filtered1> ... > merged.txt
 > PHASE1> $n -merge <dir1> <dir2> ... > merged.txt

SYNTAX PHASE2:
 > $n -parse merged.txt > statistics.csv\n\n|
}

######################################################
# PHASE1:ROUTINE USED TO PARSE ALL RESULTS BY DEFUSE #
######################################################
sub merge_defuse_results
{
    use File::Find;

    #
    # parse dei parametri
    #
    my @list = ();
    foreach my $file ( @{ (shift) } )
    {
        if ( -d $file )
        {
            find( sub { push @list, $File::Find::name if (m/filtered/) },
                $file );
        }
        else
        {
            if ( -f $file && $file =~ m/filtered/ )
            {
                push @list, $file;
            }
        }
    }

    #
    # inizio il programma
    #
    foreach my $file (@list)
    {
        open( FILE, $file ) || die;
        my $name = $file;
        $name =~ s/\//-/g;
        $name =~ s/-results.+$//;
        my %keys = ();
        while (<FILE>)
        {
            chomp;
            next if (m/^cluster_id/);
            my @a = split /\t/;

            my %type = (
                'deletion'         => $a[16],
                'eversion'         => $a[18],
                'inversion'        => $a[46],
                'interchromosomal' => $a[43]
            );

            my $type = '';
            foreach ( keys %type )
            {
                if ( $type{$_} eq 'Y' )
                {
                    $type = $_;
                    last;
                }
            }

            my $gene_chromosome1 = $a[26];
            my $gene_chromosome2 = $a[27];

            my $gene_name1 = $a[32];
            my $gene_name2 = $a[33];

            my $genomic_strand1 = $a[41];
            my $genomic_strand2 = $a[42];

            my $geneensemble1 = $a[22];
            my $geneensemble2 = $a[23];

            # ordino i geni ensembl per avere la chiave delle fusioni
            my @ens = sort( ( $geneensemble1, $geneensemble2 ) );

            my $key = join ".", @ens;
            if ( $key eq $geneensemble1 . '.' . $geneensemble2 )
            {
                @ens = (
                    $type,            $gene_chromosome1, $gene_chromosome2,
                    $gene_name1,      $gene_name2,       $genomic_strand1,
                    $genomic_strand2, $geneensemble1,    $geneensemble2,
                    $name
                );
            }
            else
            {
                @ens = (
                    $type,            $gene_chromosome2, $gene_chromosome1,
                    $gene_name2,      $gene_name1,       $genomic_strand2,
                    $genomic_strand1, $geneensemble2,    $geneensemble1,
                    $name
                );
            }
            if ( !defined $keys{$key} )
            {
                $keys{$key} = \@ens;
            }
        }
        close FILE;
        foreach my $key ( keys %keys )
        {
            print join "\t", @{ $keys{$key} };
            print "\n";
        }
    }    # foreach my $file
}

############################################################
# PHASE 2: ROUTINE USED TO PARSE FILE PROCED BY MERGE STEP #
############################################################

sub parse_merged
{
    my $merged = shift;

    # interchromosomal is a fusion with differente chrom
    # deletion, eversion, inversion are on the same chrom

    my %file    = ();
    my %samples = ();

    open( FILE, $merged ) || die;
    while (<FILE>)
    {
        chomp;
        my @a = split "\t";
        $samples{ $a[$#a] } = 0;    # nome esperimento
        my $type = shift @a;        # tipo giunzione
        $file{$type} = [] if ( !defined $file{$type} );
        push @{ $file{$type} }, \@a;
    }
    close FILE;

    my @sam = keys %samples;
    print qq|Samples: | . ( $#sam + 1 ), "\n";

    &count_feature( $file{'interchromosomal'}, 'interchromosomal' );
    &count_feature( $file{'deletion'},         'deletion' );
    &count_feature( $file{'eversion'},         'eversion' );
    &count_feature( $file{'inversion'},        'inversion' );
}

#
# COUNT GROUPS WITH ONE OR TWO CRHOM
#
sub count_feature
{
    my $list         = shift;
    my $type         = shift;
    my $total_events = 0;
    my %chrom        = ();
    my %genes        = ();
    my %jun          = ();
    my %junc         = ();
    my %genchrom     = ();

    foreach my $row (@$list)
    {
        $total_events++;

        my $chr1 = $row->[0];
        my $chr2 = $row->[1];

        my $gene1 = $row->[2];
        my $gene2 = $row->[3];

        $genchrom{$gene1} = $chr1;
        $genchrom{$gene2} = $chr2;

        $chrom{$chr1} = 0 if ( !defined $chrom{$chr1} );
        $chrom{$chr2} = 0 if ( !defined $chrom{$chr2} );

        my @gene = sort( ( $gene1, $gene2 ) );
        my $jun = join '::', @gene;
        $jun{$jun} = 0 if ( !defined $jun{$jun} );
        $jun{$jun}++;

        my @chr = sort( ( $chr1, $chr2 ) );
        my $junc = join '::', @chr;
        $junc{$junc} = 0 if ( !defined $junc{$junc} );
        $junc{$junc}++;

        $genes{$gene1} = 0 if ( !defined $genes{$gene1} );
        $genes{$gene2} = 0 if ( !defined $genes{$gene2} );

        $chrom{$chr1}++;
        $chrom{$chr2}++ if ( $chr1 ne $chr2 );

        $genes{$gene1}++;
        $genes{$gene2}++;
    }

    print qq|\n### $type\t$total_events ###\n\n|;

    print "$type: GIUNZIONI GENI:\n";
    my @jj = ();
    foreach my $jun ( keys %jun )
    {
        push @jj, [ $jun, $jun{$jun} ];
    }
    @jj = sort { $b->[1] <=> $a->[1] } @jj;
    print join "\t",
      ( 'chrom1', 'chrom2', 'gene1', 'gene2', 'fgene1', 'fgene2', 'count' );
    print "\n";

    foreach my $r (@jj)
    {

        my @gene = split '::', $r->[0];

        print join "\t",
          (
            $genchrom{ $gene[0] },
            $genchrom{ $gene[1] },
            $gene[0], $gene[1],
            $genes{ $gene[0] },
            $genes{ $gene[1] },
            $r->[1]
          );
        print "\n";

    }

    print "\n$type: CLASSIFICA geni:\n";
    print "gene\tcount\n";
    my @contageni = ();
    foreach my $k ( keys %genes )
    {
        push @contageni, [ $k, $genes{$k} ];
    }
    foreach my $p ( sort { $b->[1] <=> $a->[1] } @contageni )
    {
        print join "\t", @$p;
        print "\n";
    }

    print "\n$type: GIUNZIONI CROMOSOMI:\n";
    print "chrom1\tchrom2\tfchrom1\tfchrom2\tcount\n";
    @jj = ();
    foreach my $jun ( keys %junc )
    {
        push @jj, [ $jun, $junc{$jun} ];
    }
    @jj = sort { $b->[1] <=> $a->[1] } @jj;
    foreach my $r (@jj)
    {
        my @a = split '::', $r->[0];
        print join "\t", ( @a, $chrom{ $a[0] }, $chrom{ $a[1] }, $r->[1] );
        print "\n";
    }

    print "\n$type CLASSIFICA cromosomi:\n";
    print "cromosoma\tcount\n";
    my @contacrom = ();
    foreach my $p ( keys %chrom )
    {
        push @contacrom, [ $p, $chrom{$p} ];
    }
    foreach my $p ( sort { $b->[1] <=> $a->[1] } @contacrom )
    {
        print join "\t", @$p;
        print "\n";
    }
}
